home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / PERL / PERL5.ZIP / !Perl / Lib / Net / pm / Ping
Text File  |  1994-10-18  |  1KB  |  65 lines
  1. package Net::Ping;
  2.  
  3. # Authors: karrer@bernina.ethz.ch (Andreas Karrer)
  4. #          pmarquess@bfsec.bt.co.uk (Paul Marquess)
  5.  
  6. require Exporter;
  7.  
  8. @ISA = qw(Exporter);
  9. @EXPORT = qw(ping pingecho);
  10.  
  11. use Socket;
  12. use Carp ;
  13.  
  14. $tcp_proto = (getprotobyname('tcp'))[2];
  15. $echo_port = (getservbyname('echo', 'tcp'))[2];
  16.  
  17. sub ping {
  18.     croak "ping not implemented yet. Use pingecho()";
  19. }
  20.  
  21.  
  22. sub pingecho {
  23.  
  24.     croak "usage: pingecho host [timeout]" 
  25.         unless @_ == 1 || @_ == 2 ;
  26.  
  27.     local ($host, $timeout) = @_;
  28.     local (*PINGSOCK);
  29.     local ($saddr, $ip);
  30.     local ($ret) ;
  31.  
  32.     # check if $host is alive by connecting to its echo port, within $timeout
  33.     # (default 5) seconds. returns 1 if OK, 0 if no answer, 0 if host not found
  34.  
  35.     $timeout = 5 unless $timeout;
  36.  
  37.     if ($host =~ /^\s*((\d+\.){3}\d+)\s*$/)
  38.       { $ip = pack ('C4', split (/\./, $1)) }
  39.     else
  40.       { $ip = (gethostbyname($host))[4] }
  41.  
  42.     return 0 unless $ip;        # "no such host"
  43.  
  44.     $saddr = pack('S n a4 x8', AF_INET, $echo_port, $ip);
  45.     $SIG{'ALRM'} = sub { die } ;
  46.     alarm($timeout);
  47.  
  48.     $ret = eval <<'EOM' ;
  49.  
  50.         return 0 
  51.             unless socket(PINGSOCK, PF_INET, SOCK_STREAM, $tcp_proto) ;
  52.  
  53.         return 0 
  54.             unless connect(PINGSOCK, $saddr) ;
  55.  
  56.         return 1 ;
  57. EOM
  58.  
  59.     alarm(0);
  60.     close(PINGSOCK);
  61.     $ret == 1 ? 1 : 0 ;
  62. }   
  63.  
  64. 1;
  65.